program Beszuro;
uses crt;
var i,n:integer;
    a:array [1..50] of integer;

procedure kiir;
begin
   for i:=1 to n do begin
      writeln(a[i]);
      end;
   end;

procedure cserel(mit,mire:integer);
var x:integer;
begin
   x:=a[mit];
   a[mit]:=a[mire];
   a[mire]:=x;
   end;

procedure beszuras(k:integer); Tömb elemeinek rendezése beszúró rendezéssel, úgy, hogy megvizsgáljuk, hogy az eljárásban az aktuális bemenő elem kisebb e, mint a tömbben az azt megelező elem. Ha igen, akkor az aktuális elemet megcseréljük a másikkal és újra megvizsgáljuk, hogy az őt megelező elem kisebb e nála. Ez a cserélgetés addig megy, amíg az aktuálisan vizsgált elem meg nem találja a helyét, azaz nincs nála kisebb a listában.
begin
   while(k>1) do begin Elértük e már az első tömbelemet a vizsgálódás idején. Ha nem, folytatódik a vizsgálat.
      if (a[k]<a[k-1]) then Megvizsgáljuk, hogy az aktuális tömbelem kisebb e az őt megelőzőnél, ha igen, cserélünk. Ha ez a feltétel nem teljesül, akkor az aktuális tömbelem előtt csak kisebb elemek vannak,így nincs szükség további vizsgálatra, ezért megszakítjuk a ciklust.
         cserel (k,k-1)
      else break;
      dec(k); Csökkentjük a k értékét 1-el (helyette írhatnák, hogy k:=k-1;)
      end;
   end;

BEGIN
   clrscr;
   randomize;
   n:=10;
   writeln('A tomb elemei rendezes elott:');
   for i:=1 to n do begin
      a[i]:=trunc(90*random)+1;
      writeln(a[i]);
      end;
   writeln('');
   writeln('A tomb elemei rendezes utan:');
   i:=2;
   while (i<=n) do begin
      beszuras(i);
      i:=i+1;
      end;
   kiir;
  readkey;
END.